home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / lisp / dired-nt.el < prev    next >
Lisp/Scheme  |  1993-11-21  |  5KB  |  125 lines
  1. ;; Copyright (C) 1993 Free Software Foundation, Inc.
  2.  
  3. ;; Author: Geoff Voelker (voelker@cs.washington.edu)
  4. ;; Version: 1
  5.  
  6. ;; This file is part of GNU Emacs.
  7.  
  8. ;; GNU Emacs is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; GNU Emacs is distributed in the hope that it will be useful,
  14. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. ;; GNU General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21.  
  22. ;;; Commentary:
  23.  
  24. ;; (August 12, 1993)
  25. ;; Functions for finding the file name in a dired buffer line on NT.
  26.  
  27. ;;; Code:
  28.  
  29. ;; Move to first char of filename on this line.
  30. ;; Returns position (point) or nil if no filename on this line."
  31. (defun dired-move-to-filename (&optional raise-error eol)
  32.   ;; This is the UNIX version.
  33.   (or eol (setq eol (progn (end-of-line) (point))))
  34.   (beginning-of-line)
  35.   (if (re-search-forward
  36.        "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)[ ]+[0-9]+"
  37.        eol t)
  38.       (progn
  39.     (skip-chars-forward " ")    ; there is one SPC after day of month
  40.     (skip-chars-forward "^ " eol)    ; move after time of day 
  41.     (skip-chars-forward " " eol)    ; there is space before the year
  42.     (skip-chars-forward "[0-9]" eol)   ; move after year
  43.     (skip-chars-forward " " eol)    ; there is space before the file name
  44.     ;; Actually, if the year instead of clock time is displayed,
  45.     ;; there are (only for some ls programs?) two spaces instead
  46.     ;; of one before the name.
  47.     ;; If we could depend on ls inserting exactly one SPC we
  48.     ;; would not bomb on names _starting_ with SPC.
  49.     (save-excursion
  50.       ;; Find out what kind of file this is:  if it's a directory,
  51.       ;; skip past the "[" that ls placed at the beginning of the
  52.       ;; filename.
  53.       (if (re-search-backward "\\([^ ]\\)[-r][-a][-h][-s]" nil t)
  54.           (setq file-type (char-after (match-beginning 1)))
  55.         (or raise-error (error "No file on this line"))))
  56.     (if (eq file-type '?d)
  57.         (skip-chars-forward "[" eol)
  58.       nil)
  59.     (point))
  60.     (if raise-error
  61.     (error "No file on this line")
  62.       nil)))
  63.  
  64. (defun dired-move-to-end-of-filename (&optional no-error)
  65.   ;; Assumes point is at beginning of filename,
  66.   ;; thus the rwx bit re-search-backward below will succeed in *this*
  67.   ;; line if at all.  So, it should be called only after
  68.   ;; (dired-move-to-filename t).
  69.   ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
  70.   ;; This is the UNIX version.
  71.   (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
  72.     ;; case-fold-search is nil now, so we can test for capital F:
  73.     (setq used-F (string-match "F" dired-actual-switches)
  74.       opoint (point)
  75.           eol (save-excursion (end-of-line) (point))
  76.       hidden (and selective-display
  77.               (save-excursion (search-forward "\r" eol t))))
  78.     (if hidden
  79.     nil
  80.       (save-excursion ;; Find out what kind of file this is:
  81.     ;; Restrict perm bits to be non-blank,
  82.     ;; otherwise this matches one char to early (looking backward):
  83.     ;; "l---------" (some systems make symlinks that way)
  84.     ;; "----------" (plain file with zero perms)
  85.     ;;
  86.     ;; "drahs"
  87.     (if (re-search-backward
  88.          "\\([^ ]\\)[-r][-a][-h][-s]"
  89. ;;         "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
  90.          nil t)
  91.         (setq file-type (char-after (match-beginning 1))
  92.           symlink nil
  93.           ;; Only with -F we need to know whether it's an executable
  94.           executable nil)
  95.       (or no-error (error "No file on this line"))))
  96.       ;; Move point to end of name:
  97.       (if symlink
  98.       (if (search-forward " ->" eol t)
  99.           (progn
  100.         (forward-char -3)
  101.         (and used-F
  102.              dired-ls-F-marks-symlinks
  103.              (eq (preceding-char) ?@);; did ls really mark the link?
  104.              (forward-char -1))))
  105.     (goto-char eol);; else not a symbolic link
  106.     ;; ls -lF marks dirs, sockets and executables with exactly one
  107.     ;; trailing character. (Executable bits on symlinks ain't mean
  108.     ;; a thing, even to ls, but we know it's not a symlink.)
  109.     (and used-F
  110.          (or (memq file-type '(?d ?s))
  111.          executable)
  112.          (forward-char -1))))
  113.     (or no-error
  114.     (not (eq opoint (point)))
  115.     (error (if hidden
  116.            (substitute-command-keys
  117.             "File line is hidden, type \\[dired-hide-subdir] to unhide")
  118.          "No file on this line")))
  119.     (if (eq opoint (point))
  120.     nil
  121.       (if (eq file-type '?d)  ; if it's a directory, skip past the "]" at
  122.       (forward-char -1)   ; the end of the filename
  123.     nil))
  124.     (point)))
  125.